{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit NavigationDiagram;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, MiscUtils,
  VisualUtils, Graphics;

type
  {$INTERFACES CORBA}
  INavigationDiagramHost = interface
    ['5fdc0974f44961f1']
    function GetItemColor(ItemIndex: Integer): TColor;
    function GetItemHint(ItemIndex: Integer): String;
    procedure ItemSelected(ItemIndex: Integer);
  end;
  {$INTERFACES DEFAULT}

  TNavigationDiagramFrame = class(TFrame)
    lblItemCount: TLabel;
    lblItemIndex: TLabel;
    lblItemIndexTitle: TLabel;
    pbxDiagram: TPaintBox;
    pnlText: TPanel;
    procedure pbxDiagramClick(Sender: TObject);
    procedure pbxDiagramMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure pbxDiagramPaint(Sender: TObject);
  private type
    TSegment = record
      Left: Integer;
      Width: Integer;
    end;
    TSegmentArray = array of TSegment;
  private
    FHost: INavigationDiagramHost;
    FSelectionEnabled: Boolean;
    FValues: TIntegerArray;
    FTotal: Int64;
    FSelectedItemIndex: Integer;
    function GetLayout: TSegmentArray;
    procedure DisplaySelectedItemIndex(Value: Integer);
    procedure SetSelectedItemIndex(Value: Integer);
    procedure Prepare;
    procedure SetSelectionEnabled(Value: Boolean);
    function GetItemIndexAt(x: Integer): Integer;
    { private declarations }
  public
    class function Embed(const Values: TIntegerArray; Host: INavigationDiagramHost;
      Parent: TWinControl): TNavigationDiagramFrame;
    procedure ColorsChanged;

    property SelectedItemIndex: Integer read FSelectedItemIndex write SetSelectedItemIndex;
    property SelectionEnabled: Boolean read FSelectionEnabled write SetSelectionEnabled;
    { public declarations }
  end;

implementation

{$R *.lfm}

resourcestring
  SItemCount = 'of %d';

{ TNavigationDiagramFrame }

procedure TNavigationDiagramFrame.pbxDiagramPaint(Sender: TObject);
var
  Layout: TSegmentArray;
  i: Integer;
  r, r1: TRect;
  Color: TColor;
  c: TCanvas;
  Selected: Boolean;
begin
  Layout := GetLayout;
  c := pbxDiagram.Canvas;
  r.Top := 0;
  r.Bottom := pbxDiagram.ClientHeight;
  c.Pen.Style := psInsideFrame;

  for i := 0 to High(Layout) do
  begin
    r.Left := Layout[i].Left + 1;
    r.Right := r.Left + Layout[i].Width - 2;
    if r.Left < r.Right then
    begin
      Selected := i = FSelectedItemIndex;
      if Selected then
      begin
        c.Pen.Width := 2;
        c.Pen.JoinStyle := pjsMiter;
        c.Pen.Color := clMaroon;
        c.Frame(r);
      end;

      Color := FHost.GetItemColor(i);
      if Color = clNone then
      begin
        if not Selected then
        begin
          c.Pen.Width := 1;
          c.Pen.Color := clGrayText;
          c.Frame(r);
        end;
      end
      else
      begin
        c.Brush.Color := Color;
        if Selected then
          r1 := InflateRectangle(r, -3, -3)
        else
          r1 := r;
        if r1.Left < r1.Right then
          c.FillRect(r1);
      end;
    end;
  end;
end;

function TNavigationDiagramFrame.GetLayout: TSegmentArray;
var
  i, t, tx: Integer;
begin
  SetLength(Result, Length(FValues));
  if Length(Result) > 0 then
  begin
    t := 0;
    tx := 0;
    for i := 0 to High(FValues) do
    begin
      Result[i].Left := tx;
      t := t + FValues[i];
      tx := Round(t / FTotal * pbxDiagram.ClientWidth);
      Result[i].Width := tx - Result[i].Left;
    end;
  end;
end;

procedure TNavigationDiagramFrame.DisplaySelectedItemIndex(Value: Integer);
begin
  lblItemIndex.Caption := Format(' %d ', [Value + 1]);
end;

procedure TNavigationDiagramFrame.SetSelectedItemIndex(Value: Integer);
begin
  Assert( Value >= 0 );
  Assert( Value < Length(FValues) );
  if FSelectedItemIndex <> Value then
  begin
    FSelectedItemIndex := Value;
    DisplaySelectedItemIndex(FSelectedItemIndex);
    pbxDiagram.Invalidate;
  end;
end;

procedure TNavigationDiagramFrame.Prepare;
var
  v: Integer;
begin
  Assert( Length(FValues) > 0 );
  for v in FValues do
  begin
    Assert( v > 0 );
    Inc(FTotal, v);
  end;

  SetFixedHeightConstraint(pbxDiagram, ScalePixels(16));

  lblItemCount.Caption := Format(SItemCount, [Length(FValues)]) + '  ';
  DisplaySelectedItemIndex(High(FValues));
  HandleNeeded;
  pnlText.Constraints.MinWidth := GetPreferredControlSize(pnlText).cx;
  DisplaySelectedItemIndex(FSelectedItemIndex);

  SelectionEnabled := TRUE;
end;

procedure TNavigationDiagramFrame.SetSelectionEnabled(Value: Boolean);
begin
  if FSelectionEnabled <> Value then
  begin
    FSelectionEnabled := Value;
    if FSelectionEnabled then
      pbxDiagram.Cursor := crHandPoint
    else
      pbxDiagram.Cursor := crDefault;
  end;
end;

function TNavigationDiagramFrame.GetItemIndexAt(x: Integer): Integer;
var
  Layout: TSegmentArray;
  i: Integer;
begin
  Result := -1;
  Layout := GetLayout;
  for i := 0 to High(Layout) do
  begin
    if (x >= Layout[i].Left) and (x < Layout[i].Left + Layout[i].Width) then
    begin
      Result := i;
      Break;
    end;
  end;
end;

procedure TNavigationDiagramFrame.pbxDiagramClick(Sender: TObject);
var
  ItemIndex: Integer;
begin
  if FSelectionEnabled then
  begin
    ItemIndex := GetItemIndexAt(pbxDiagram.ScreenToClient(Mouse.CursorPos).x);
    if (ItemIndex <> -1) and (ItemIndex <> FSelectedItemIndex) then
      FHost.ItemSelected(ItemIndex);
  end;
end;

procedure TNavigationDiagramFrame.pbxDiagramMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  ItemIndex: Integer;
  s: String;
begin
  ItemIndex := GetItemIndexAt(X);
  if ItemIndex = -1 then
    s := ''
  else
    s := FHost.GetItemHint(ItemIndex);
  if pbxDiagram.Hint <> s then
  begin
    pbxDiagram.Hint := s;
    Application.ActivateHint(Mouse.CursorPos);
  end;
end;

class function TNavigationDiagramFrame.Embed(const Values: TIntegerArray;
  Host: INavigationDiagramHost; Parent: TWinControl): TNavigationDiagramFrame;
begin
  Result := TNavigationDiagramFrame.Create(nil);
  try
    Result.FValues := Copy(Values);
    Result.FHost := Host;
    Result.Parent := Parent;
    Result.Prepare;
  except
    Result.Free;
    raise;
  end;
end;

procedure TNavigationDiagramFrame.ColorsChanged;
begin
  pbxDiagram.Invalidate;
end;

end.

